Hyper Stacks 1994 May/Hyper Stacks (Pacific HiTech)(1994)[Mac].iso/HyperTalk/LightSpeed HC XCMD kit/XCMD Utilities.p

Text File | 1987-11-11 | 8.6 KB | 481 lines | [TEXT/PJMM]

{ Hypercard XCMD utilities unit for Lightspeed Pascal }

{ (c) 1987 Symantec Corp.  THINK Technologies Division }

{ Adapted for use with Lightspeed Pascal from information provided }
{ by Apple Computer, Inc. }

UNIT XCMDUtils;

INTERFACE

    USES
        XCMDIntf;

    TYPE
        Str31 = STRING[31];

    FUNCTION StringMatch (paramPtr : XCmdPtr;
                                    pattern : Str255;
                                    target : Ptr) : Ptr;

    FUNCTION PasToZero (paramPtr : XCmdPtr;
                                    str : Str255) : Handle;

    PROCEDURE ZeroToPas (paramPtr : XCmdPtr;
                                    zeroStr : Ptr;
                                    VAR pasStr : Str255);

    FUNCTION StrToLong (paramPtr : XCmdPtr;
                                    str : Str31) : LongInt;

    FUNCTION StrToNum (paramPtr : XCmdPtr;
                                    str : Str31) : LongInt;

    FUNCTION StrToBool (paramPtr : XCmdPtr;
                                    str : Str31) : BOOLEAN;

    FUNCTION StrToExt (paramPtr : XCmdPtr;
                                    str : Str31) : Extended;

    FUNCTION LongToStr (paramPtr : XCmdPtr;
                                    posNum : LongInt) : Str31;

    FUNCTION NumToStr (paramPtr : XCmdPtr;
                                    num : LongInt) : Str31;

    FUNCTION NumToHex (paramPtr : XCmdPtr;
                                    num : LongInt;
                                    nDigits : INTEGER) : Str31;

    FUNCTION ExtToStr (paramPtr : XCmdPtr;
                                    num : Extended) : Str31;

    FUNCTION BoolToStr (paramPtr : XCmdPtr;
                                    bool : BOOLEAN) : Str31;

    PROCEDURE SendCardMessage (paramPtr : XCmdPtr;
                                    msg : Str255);

    FUNCTION EvalExpr (paramPtr : XCmdPtr;
                                    expr : Str255) : Handle;

    FUNCTION StringLength (paramPtr : XCmdPtr;
                                    strPtr : Ptr) : LongInt;

    FUNCTION GetGlobal (paramPtr : XCmdPtr;
                                    globName : Str255) : Handle;

    PROCEDURE SetGlobal (paramPtr : XCmdPtr;
                                    globName : Str255;
                                    globValue : Handle);

    FUNCTION GetFieldByName (paramPtr : XCmdPtr;
                                    cardFieldFlag : BOOLEAN;
                                    fieldName : Str255) : Handle;

    FUNCTION GetFieldByNum (paramPtr : XCmdPtr;
                                    cardFieldFlag : BOOLEAN;
                                    fieldNum : INTEGER) : Handle;

    FUNCTION GetFieldByID (paramPtr : XCmdPtr;
                                    cardFieldFlag : BOOLEAN;
                                    fieldID : INTEGER) : Handle;

    PROCEDURE SetFieldByName (paramPtr : XCmdPtr;
                                    cardFieldFlag : BOOLEAN;
                                    fieldName : Str255;
                                    fieldVal : Handle);

    PROCEDURE SetFieldByNum (paramPtr : XCmdPtr;
                                    cardFieldFlag : BOOLEAN;
                                    fieldNum : INTEGER;
                                    fieldVal : Handle);

    PROCEDURE SetFieldByID (paramPtr : XCmdPtr;
                                    cardFieldFlag : BOOLEAN;
                                    fieldID : INTEGER;
                                    fieldVal : Handle);

    FUNCTION StringEqual (paramPtr : XCmdPtr;
                                    str1, str2 : Str255) : BOOLEAN;

    PROCEDURE ReturnToPas (paramPtr : XCmdPtr;
                                    zeroStr : Ptr;
                                    VAR pasStr : Str255);

    PROCEDURE ScanToReturn (paramPtr : XCmdPtr;
                                    VAR scanPtr : Ptr);

    PROCEDURE ScanToZero (paramPtr : XCmdPtr;
                                    VAR scanPtr : Ptr);

    PROCEDURE ZeroBytes (paramPtr : XCmdPtr;
                                    dstPtr : Ptr;
                                    longCount : LongInt);

IMPLEMENTATION

    PROCEDURE DoJsr (addr : ProcPtr);
    INLINE
        $205F, $4E90;

    FUNCTION StringMatch;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@pattern);
                inArgs[2] := ORD(target);
                request := xreqStringMatch;
                DoJsr(entryPoint);
                StringMatch := Ptr(outArgs[1]);
            END;
    END;


    FUNCTION PasToZero;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@str);
                request := xreqPasToZero;
                DoJsr(entryPoint);
                PasToZero := Handle(outArgs[1]);
            END;
    END;


    PROCEDURE ZeroToPas;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(zeroStr);
                inArgs[2] := ORD(@pasStr);
                request := xreqZeroToPas;
                DoJsr(entryPoint);
            END;
    END;


    FUNCTION StrToLong;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@str);
                request := xreqStrToLong;
                DoJsr(entryPoint);
                StrToLong := outArgs[1];
            END;
    END;


    FUNCTION StrToNum;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@str);
                request := xreqStrToNum;
                DoJsr(entryPoint);
                StrToNum := outArgs[1];
            END;
    END;


    FUNCTION StrToBool;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@str);
                request := xreqStrToBool;
                DoJsr(entryPoint);
                StrToBool := BOOLEAN(outArgs[1]);
            END;
    END;


    FUNCTION StrToExt;
        VAR
            x : Extended;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@str);
                inArgs[2] := ORD(@x);
                request := xreqStrToExt;
                DoJsr(entryPoint);
                StrToExt := x;
            END;
    END;


    FUNCTION LongToStr;
        VAR
            str : Str31;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := posNum;
                inArgs[2] := ORD(@str);
                request := xreqLongToStr;
                DoJsr(entryPoint);
                LongToStr := str;
            END;
    END;


    FUNCTION NumToStr;
        VAR
            str : Str31;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := num;
                inArgs[2] := ORD(@str);
                request := xreqNumToStr;
                DoJsr(entryPoint);
                NumToStr := str;
            END;
    END;


    FUNCTION NumToHex;
        VAR
            str : Str31;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := num;
                inArgs[2] := nDigits;
                inArgs[3] := ORD(@str);
                request := xreqNumToHex;
                DoJsr(entryPoint);
                NumToHex := str;
            END;
    END;


    FUNCTION ExtToStr;
        VAR
            str : Str31;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@num);
                inArgs[2] := ORD(@str);
                request := xreqExtToStr;
                DoJsr(entryPoint);
                ExtToStr := str;
            END;
    END;


    FUNCTION BoolToStr;
        VAR
            str : Str31;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := LongInt(bool);
                inArgs[2] := ORD(@str);
                request := xreqBoolToStr;
                DoJsr(entryPoint);
                BoolToStr := str;
            END;
    END;


    PROCEDURE SendCardMessage;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@msg);
                request := xreqSendCardMessage;
                DoJsr(entryPoint);
            END;
    END;


    FUNCTION EvalExpr;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@expr);
                request := xreqEvalExpr;
                DoJsr(entryPoint);
                EvalExpr := Handle(outArgs[1]);
            END;
    END;


    FUNCTION StringLength;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(strPtr);
                request := xreqStringLength;
                DoJsr(entryPoint);
                StringLength := outArgs[1];
            END;
    END;


    FUNCTION GetGlobal;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@globName);
                request := xreqGetGlobal;
                DoJsr(entryPoint);
                GetGlobal := Handle(outArgs[1]);
            END;
    END;


    PROCEDURE SetGlobal;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@globName);
                inArgs[2] := ORD(globValue);
                request := xreqSetGlobal;
                DoJsr(entryPoint);
            END;
    END;


    FUNCTION GetFieldByName;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(cardFieldFlag);
                inArgs[2] := ORD(@fieldName);
                request := xreqGetFieldByName;
                DoJsr(entryPoint);
                GetFieldByName := Handle(outArgs[1]);
            END;
    END;


    FUNCTION GetFieldByNum;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(cardFieldFlag);
                inArgs[2] := fieldNum;
                request := xreqGetFieldByNum;
                DoJsr(entryPoint);
                GetFieldByNum := Handle(outArgs[1]);
            END;
    END;


    FUNCTION GetFieldByID;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(cardFieldFlag);
                inArgs[2] := fieldID;
                request := xreqGetFieldByID;
                DoJsr(entryPoint);
                GetFieldByID := Handle(outArgs[1]);
            END;
    END;


    PROCEDURE SetFieldByName;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(cardFieldFlag);
                inArgs[2] := ORD(@fieldName);
                inArgs[3] := ORD(fieldVal);
                request := xreqSetFieldByName;
                DoJsr(entryPoint);
            END;
    END;


    PROCEDURE SetFieldByNum;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(cardFieldFlag);
                inArgs[2] := fieldNum;
                inArgs[3] := ORD(fieldVal);
                request := xreqSetFieldByNum;
                DoJsr(entryPoint);
            END;
    END;


    PROCEDURE SetFieldByID;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(cardFieldFlag);
                inArgs[2] := fieldID;
                inArgs[3] := ORD(fieldVal);
                request := xreqSetFieldByID;
                DoJsr(entryPoint);
            END;
    END;


    FUNCTION StringEqual;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@str1);
                inArgs[2] := ORD(@str2);
                request := xreqStringEqual;
                DoJsr(entryPoint);
                StringEqual := BOOLEAN(outArgs[1]);
            END;
    END;


    PROCEDURE ReturnToPas;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(zeroStr);
                inArgs[2] := ORD(@pasStr);
                request := xreqReturnToPas;
                DoJsr(entryPoint);
            END;
    END;


    PROCEDURE ScanToReturn;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@scanPtr);
                request := xreqScanToReturn;
                DoJsr(entryPoint);
            END;
    END;


    PROCEDURE ScanToZero;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(@scanPtr);
                request := xreqScanToZero;
                DoJsr(entryPoint);
            END;
    END;


    PROCEDURE ZeroBytes;
    BEGIN
        WITH paramPtr^ DO
            BEGIN
                inArgs[1] := ORD(dstPtr);
                inArgs[2] := longCount;
                request := xreqZeroBytes;
                DoJsr(entryPoint);
            END;
    END;
END.